************************************************** * * EFLD - Program for EFLD Evaluation PWB * This listing is provided for information * purposes only. It is not intended for * use outside of the 33794EVM. * The user assumes all risk of it’s suitablity * if any or all of it is used in any other * application. * Copyright Motorola 2002 * * Rev 1.5 * Adder functionallity: * by: * Edgar Saenz 02/19/2003 * AD0 assigned to Power Monitoring sensing * AD3 assigned to Vdd Monitoring sensing * AD3 assigned to Electrode level sensing * Cyclone uses PTA0 routines customized from ** Edgar Saenz 03/20/2003 * Mon08 code to suit EVB operations. * ** Ron DeLong 05/07/2003 * Rewrote DoSelEl to stop lower bits of * ptb from changing selected electrode and * overwriting shield driver selection. * Eliminated ElTable now that selection * is straight binary. ************************************************** $SETNOT icd ;set ICD for use in ICD, else setnot .PAGELENGTH 0 .PAGEWIDTH 100 RAMStart EQU $0080 RomStart EQU $EE00 ; This is valid ROM on the Q Series ;VectorStart EQU $FFDC VectorStart EQU $FDEB $Include 'Qregs_Contest.inc' org RAMStart ***** * RAM variables ***** InBuf rmb 64 ;command line buffer EndBuf equ * ;end-of-buffer (+1) *** not compiling when 0x80 ComBuf rmb 8 ;command buffer ** is declared as a RAMStart. EndCom equ * ;end-of-buffer (+1) org $c3 BufPtr rmb 2 ;16-bit pointer into InBuf NxtCmnd rmb 2 ;pointer to nxt command entry Count rmb 1 ;# of chars in command ShftReg rmb 2 ;buffer for 4 hex digits comBufPtr rmb 1 ;pointer to chars in command buffer cmdLength rmb 1 ;count of chars in command buffer cmdTblPtr rmb 2 ;pointer to current command in table nxtCmdTblPtr rmb 2 ;pointer to next command in table cmdTblLength rmb 1 ;length of current command table command charMatch rmb 1 ;number of command chars that match jsrVector rmb 2 ;address for indirect jsr numCount rmb 1 ;number of numeric characters in INBUF electrode rmb 1 ;current electrode selection cmdPtr rmb 2 ;pointer to the command character tempb rmb 1 ;temporary holder Accum rmb 1 ;Used to build an Accumulator value ***************************** Char_Temp rmb 1 org RomStart main rsp clrh ;x to first pageOutCrLf jsr Init jmp Prompt ;send a prompt to the screen Init: lda $ffc0 ;Trim base reference value sta $38 ;Load to OCSTRIM bclr Com_Pin,DDRA ;DDRA 0 as an input ;mov #%00000011,CONFIG2 ; *** mov #%00000001,CONFIG1 ;Disable COP mov #%00110000,ADCLK ;use internal bus clock/2 for A/D mov #%00100011,ADSCR ;continuous AD on ch0. No interrupts. mov #%00010000,PTB ;point to electrode 1, sd on non-test mov #%11111000,DDRB ;set up portd outputs *** RTS ***** * OutMsgCr - send then a text message pointed-to by X * until a $04 terminating character found ***** * OutMsg - same as above except no leading * on return X points at next location after the $04 * that terminated the message and A=$04 ***** OutMsgCr: bsr OutCrLf ;send and OutMsg: lda 0,x ;get next msg char and post inc X aix #01 ;pointer to next char cmp #$04 ;end of message? beq xmsg ;if so, exit bsr OutChar ;else output message character bra OutMsg ;repeat until $04 found xmsg clrh ;get x back to page 1 rts ;** RETURN ** ***** * OutCrLf - transmit and ***** OutCrLf: lda #$0D ;ASCII 0x0D bsr OutChar ;send carriage return OutLf: lda #$0A ;ASCII *Fall into OutChar ***** * OutChar - Output character from A to SCI * character remains in A on return * waits for TDRE before sending ***** bsr OutChar rts ***** * InEcho - wait for Rx character and echo before return * don't echo if < $20 or > $7A lower case z * especially don't echo backspace or * character is in A upon return (even if not echoed) ***** InEcho: bsr InChar ;check for an Rx character beq InEcho ;loop until one comes cmpa #$20 ;ASCII space blt xecho ;don't echo control chars cmpa #'z' ;ASCII z (lower case) bgt xecho ;don't echo any above z ;bsr OutChar ;then echo it xecho rts ;** RETURN ** ***** * InChar - Input a character through SCI if ready * Return character (MSB stripped to 0) or $00 in A * If Z set on return, there was no char ***** ;********************************************************************* ;* Utility subroutines - usually placed after main code ;********************************************************************* ***************************************************************************** * Subroutine GET_PUT * * * * Attempts to receive a byte from the external controller via PortA0. * * Once called, program will remain in GET_PUT until a byte is received * * Signal to start receiving a byte is a valid (low) start bit. * * * * If command is correctly received then it is echoed to the controller via * * a branch into the PUT_BYTE routine. PUT_BYTE returns to the main loop * * normally via an RTS. * * * * If no stop bit is received then the command is treated like a break even * * if the byte is non-zero:- * * In this error situation, GET_PUT will terminate by branching to ECHO_BRK * * which sends a break to the controller, cleans the stack and JUMPs back * * to the start of the main command loop. * * * * NOTE: Cycle path for each bit reception must be kept the same to maintain * * a steady baud rate. * * * * Entry Conditions: Port A0 configured as an input. * * Exit Conditions: If result good then Acc=byte received. * * If break received or result bad then send break and * * jump back to start. * * Port A0 configured as an input. * * * * Baud rate calculation: The G_BIT loop below takes 9 cycles plus the * * the number of cycles taken by the GET_BIT subroutine. * * So total cycles per bit = 9 + 17 + [10 x SAMPL_NO] * * With a 9.8304 MHz XTAL which produces a 2.4576 MHz internal * * frequency * * frequency, a bus cycle of 0.4069 uS is achieved. * * With SAMPL_NO = 23, Bit time = 256 cycles = 9600 baud * * *GetChar:* * ***************************************************************************** InChar: BRSET Com_Pin,PTA,InChar ;5 - waiting for start edge. BSR GET_BIT ;4+[17+10(SAMPL_NO)] try to receive a full start bit. BCS InChar ;4 Success? LDA #$80 ;2 initialise receiver. G_BIT: ; got start bit, now get byte. BSR GET_BIT ;4+[17+10(SAMPL_NO)] RORA ;1 bit into acc NOP ;1 baud padding BCC G_BIT ;3 get next bit * ;baud calculation STOP_BIT: BSR GET_BIT ; look for stop bit ; Return ACC RTS ;***************************************************************************** ;* Subroutine GET_BIT: * ;* Receives a bit from controller via PA0. Performs "SAMPL_NO" samples per * ;* bit and returns the bit value via the C bit. * ;* * ;* Entry Conditions: Port A0 configured as an input. * ;* Exit Conditions: If No '1s' > OFFSET then * ;* C = 1 (Bit = 1) * ;* Else * ;* C = 0 (Bit = 0) * ;* Port A0 configured as an input. * ;* * ;* Execution Time (bus cycles) = 17 + [10 x SAMPL_NO] * ;***************************************************************************** GET_BIT: PSHX ;2 PSHA ;2 LDA #OFFSET ;2 OFFSET determines 0 and 1 weighting. LDX #SAMPL_NO ;2 load number of samples in a bit LOOP_IN: BRCLR Com_Pin,PTA,SUB_SMP ;5 SUB_SMP: SBC #0 ;2 DBNZX LOOP_IN ;3 ROLA ;1 ;put bit in carry PULA ;2 Restore stack and A & X PULX ;2 RTS ;4 ;-- ;17+10*SAMPL_NO ***************************************************************************** * Subroutine PutChar: * * * * Transmits a byte to the external controller via PortA0. * * Waits for PA0 to go high and then waits 2 bit times before transmiting. * * Manipulates PA0 DDR for wired-OR operation to avoid contention issues * * * * Can be called as a subroutine, but also forms part of GET_PUT subroutine * * * * NOTE: Cycle path for each bit generation must be the same to maintain a * * steady baud rate. * * * * Entry Conditions: Port A0 configured as an input, PA0 data bit = 0 * * Byte to send in Acc. * * Exit Conditions: Byte transmitted in Acc. * * Port A0 configured as an input. * * * * Baud rate calculation: The monitor baud rate is limited by the GET_BYTE * * routine. The timing loops in PUT_BYTE should be adjusted to produce the * * same bit time as that of GET_BYTE. * *PutChar: ***************************************************************************** OutChar PSHX ;2 Save X it can be used for temp storage. PSHA ;2 Temporarily store transmit byte. STA Char_Temp LDA #$A ;2 restore data when done ( 9 rotates thru C) WT_HIGH: BRCLR Com_Pin,PTA,WT_HIGH ;5 Wait for controller to release data line. LDX #BITX2 ; DEL: DBNZX DEL ;(3*BITX2) Wait 2 bit times before ; transmitting. SEC ;1 set carry ready for stop bit generation BRA OUT_LOW ;3 put out start bit *-------------------------------------------------------------------------------- PUT_LOOP: ;ROR 1,SP ;5 rotate transmit byte: LSB -> carry. ROR Char_Temp BCC OUT_LOW ;3 is bit a 1 or 0? OUT_HI: BCLR Com_Pin,DDRA ;4 'Output' a high bit by making pin an input BRA OUT_DELAY ;3 OUT_LOW: BSET Com_Pin,DDRA ;4 Output a low bit BCLR Com_Pin,PTA ;4 Output a low bit BRA OUT_DELAY ;3 maintain same bit time for 1 and 0 OUT_DELAY: LDX #BITTIM ;2 DEL_OUT: DBNZX DEL_OUT ;3 1 bit time delay. DBNZA PUT_LOOP ;3 done? *-------------------------------------------------------------------------------- BCLR Com_Pin,DDRA ;4 Output a low bit ;17 + 3 * BITTIM = 254 CYCLES @ 2.4576 MHz ~ ;104uS PULA ;2 PULX ;2 RTS ;4 Restore X and Acc and return. ***** * OutSp - transmit ***** OutSp: lda #$20 ;ASCII bra OutChar ;send space and RETURN ***** * Prompt - Here whenever a new prompt is to be printed * print > and fill InBuf * handled and terminates input * X used as pointer into InBuf ***** Prompt: clrh ;start with x in 0 page jsr OutCrLf ;move to start of next line lda #'>' ;prompt character jsr OutChar ;after prompt return to main loop ldx #EndBuf ;end of command line buffer bufclr decx ;pre-decrement clr 0,x ;clear command line buffer cpx #InBuf ;done? bne bufclr ;loop till all cleared buflp jsr InEcho ;get and echo next character cmpa #$08 ;check for backspace bne addchar ;if not add it to buffer cpx #InBuf ;see if room to back up beq buflp ;loop if already at start * handle backspace character decx ;pre-decrement clr 0,x ;erase previous char from buffer jsr OutChar ;back up cursor jsr OutSp ;write over with a space lda #$08 ;ASCII backspace jsr OutChar ;move cursor back again bra buflp ;loop for next character addchar jsr UpCase ;decode easier if all upper case sta 0,x ;place in input buffer incx cmpa #$0D ;check for ASCII beq dunbuf ;if so, end filling buffer cpx #EndBuf ;see if past end of buffer bne buflp ;if not, continue filling badlong ldhx #MsgLong ;too many characters jsr OutMsgCr ;'Too long' bra Prompt ;start over with new prompt dunbuf: ;command line entered, now extract 1st command clrh ;page 0 ldx #InBuf ;point at buffer start stx BufPtr ;store in buffer pointer ldx #EndCom ;point at command buffer end clrlp1 decx clr 0,x ;clear cpx #ComBuf ;done? bne clrlp1 stx ComBufPtr ;points to begining of Com ldx BufPtr ;to input buffer jsr WSkip ;advance BufPtr to first non-whitespace beq Prompt ;nothing was entered clr cmdLength ;will hold # of chars in command mvcmnd ldx ComBufPtr ;combuf ptr cpx #EndCom beq badlong ;command is too long inc cmdLength ;inc # of chars in command sta 0,x ;move to command buffer incx ;ComBuffer to next position stx ComBufPtr inc BufPtr ldx BufPtr ;to next character in inbuf lda 0,x ;get next character from inbuf jsr DCheck ; or whitespace marks end bne mvcmnd ;loop for more command characters ****************************************** * * decode - Decode Commands * * The first argument is in ComBuf. * Determine if there is a match of the * argument with the commands. * ****************************************** decode ldhx #CmdTbl ;set CmdTblPtr sthx cmdTblPtr sthx nxtCmdTblPtr ;preset for loop entry dectop ldhx nxtCmdTblPtr ;command to check lda 0,x ;get length of command and check for end cmp #$FF ;FF indicates the end of the command table beq noMatch sta cmdTblLength aix #1 ;step over cmdLength sthx cmdTblPtr ;now at first char in command table to check inca ;compute next command location inca ;step over two bytes of address add cmdTblPtr+1 ;now over command characters sta nxtCmdTblPtr+1 ;next X pointer lda #00 adc cmdTblPtr ;update H in case of page crossing sta nxtCmdTblPtr ;now pointing to next command clr charMatch ;start with no matching characters ldhx cmdTblPtr sthx cmdPtr ;will use this as pointer to command table chars ldx #ComBuf ;start at beginning of ComBuffer decLoop inc charMatch ;start with 1 match pshx ;preserve ComBuff pointer ldhx cmdPtr lda 0,x ;get char in table aix #1 sthx cmdPtr ;to next char pulx ;get current ComBuf pointer clrh ;point to page 0 cmp 0,x ;char match? bne dectop ;if not, to next command incx ;to next character in buffer lda charMatch cmp cmdLength ;if length shows a match of all entered chars, got it blt decLoop lda cmdTblLength ;now find address of routine in table add cmdTblPtr+1 ;use cmdTblPtr as pointer to address values sta cmdTblPtr+1 lda cmdTblPtr adc #00 sta cmdTblPtr ldhx cmdTblPtr lda 0,x ;get high byte of command routine address sta jsrVector lda 1,x ;now the low byte sta jsrVector+1 ldhx jsrVector ;now have the vector in jsrVector jsr 0,x jmp Prompt NoMatch: * Not in command table ldhx #MsgNotF ;'Command not found?' jsr OutMsgCr ;bell and display error jmp Prompt ;New prompt & wait for next command ************************************************* * * get arg * Locate first argument. It is the first string * following a whitespace after the command. * * Exit with the location in x. If no argument, * x=0. * ************************************************* getArg clrh ;x in first page ldx #InBuf decx getArgLoop incx lda 0,x ;get character cmp #0d ;check for beq cr jsr WCheck ;is it a whitespace bne getArgLoop ;try next character getNonW incx ;now look for non-white lda 0,x cmp #0d ;? beq noArg jsr WCheck beq getNonW rts ;return with X pointing to argument noArg clrx rts cr clrx ;return with 0 in x if no argument found rts ***** * WSkip - advance BufPtr to point at next non-whitespace * character. On return, X and BufPtr point at next * non-whitespace char and A holds that character. The * Z bit reflects a comparison against . Whitespace * characters include , comma, and tab ($09). ***** WSkip: ldx BufPtr ;point X into input buffer wskip1 lda 0,x ;get next char bsr WCheck ;see if , tab, or comma bne notwht ;not a whitespace character skip1 incx ;advance pointer in X bra wskip1 ;go check next character notwht stx BufPtr ;update buffer pointer cmp #$0D ;to set or clear Z bit rts ;** RETURN ** ***** * WCheck - checks character in A for whitespace. Whitespace * characters include , comma, and tab ($09). * If it was, Z is set upon return so you can use BEQ ***** WCheck: cmp #',' ;check for comma beq xwchk ;skip and check next cmp #$20 ;check for space beq xwchk ;skip and check next cmp #$09 ;check for tab xwchk rts ;** RETURN ** ***** * DCheck - checks character in A for whitespace or * if it was, Z is set upon return so you can use BEQ ***** DCheck: bsr WCheck ;skip and check next beq xdchk ;exit if it was whitespace cmp #$0D ;check for xdchk rts ;** RETURN ** ***** * UpCase - convert ASCII character to upper case * if not a-z, don't change it ***** UpCase: cmp #'a' ;lower case a blt xupcase ;exit if < a cmp #'z' ;lower case a bgt xupcase ;exit if > z sub #$20 ;change to upper case xupcase rts ;** RETURN ** ***** * Out2Hx - Convert A to 2 ASCII hex digits and display ***** Out2Hx: psha ;save a copy lsra lsra lsra lsra ;upper digit to low cmp #9 ;see if .gt. 9 ble arnfix1 add #7 ;adjust for A-F arnfix1 add #$30 ;convert to ASCII jsr OutChar ;display upper digit pula ;recover copy and #$0F ;strip off upper digit cmp #9 ;see if .gt. 9 ble arnfix2 add #7 ;adjust for A-F arnfix2 add #$30 ;convert to ASCII jmp OutChar ;display lower digit ***** * NibbleOut - Convert lower nibble of A to ASCII hex digit and display ***** NibbleOut: and #$0F ;strip off upper digit cmp #9 ;see if .gt. 9 ble arnfix3 add #7 ;adjust for A-F arnfix3 add #$30 ;convert to ASCII jmp OutChar ;display lower digit ***** * HexBin - converts character in A from ASCII to binary * Exits with hex value in A ***** HexBin: pshx ;save registers mov #4,tempb ;loop counter jsr UpCase ;in case a-f cmp #'0' ;ASCII zero blt xhex ;not a valid hex digit cmp #'9' ;ASCII 9 ble okhex ;must be 0-9 cmp #'A' ;ASCII A blt xhex ;bad - between 9 and A cmp #'F' ;ASCII F bgt xhex ;bad - past F add #9 ;compensate for A-F okhex and #$0F ;convert to binary pulx rts ;** RETURN ** xhex lda #$FF ;return $FF for invalid argument rts ***** * DoHELP - Show a list of legal commands ***** DoHELP: ldhx #MsgHelp ;help screen jmp OutMsgCr ***** * DoSelEl - Select electrode ***** DoSelEl: clrh ;will not be cleared by sending message jsr getArg ;check for number argument jsr UpCase cmp #'0' ;compare to ASCII 0 blo outOfRange cmp #'F' ;compare to ASCII F bhi notElectrode cmp #'A' ;compare to ASCII a blo dontAdd add #$9 ;make a = a in lower nibble dontAdd: mov #%00100011,ADSCR ;select AD3 for input and #%00001111 ;get lower nibble sta electrode ;store current electrode number lsla ;shift electrode bits from lower lsla ; to upper nibble. lsla ; PB4:PB7 used to select electrodes lsla ; on Nitron boards sta Accum ;will need to move into upper nibble of ptb lda ptb ;leave lower nibble alone and #%00001111 ;clear upper nibble ora Accum ;upper nibble is electrode, lower is unchanged sta ptb ;select electrode *** ldhx #MsgSelEl ;say electrode selection jsr OutMsgCr lda electrode jmp nibbleOut ;selected electrode to output notElectrode: ;check for pwr_in_mon (P), Vdd (V) or external (X) cmp #'P' bne notPwr ; mov #%00100001,ADSCR ; ldhx #MsgSelPwr ; jmp OutMsgCr notPwr cmp #'V' bne notVdd ; mov #%00100010,ADSCR ; ldhx #MsgSelVdd jmp OutMsgCr notVdd cmp #'X' bne outOfRange mov #%00100011,ADSCR ldhx #MsgSelExtern jmp OutMsgCr outOfRange: ldhx #MsgOutOfRange jmp OutMsgCr ***** * DoEl2Hx - Measure electrode and output as 2 digit hex ***** DoEl2Hx: clrh jsr OutLf lda ADR ;A/D value ***??? jmp Out2Hx ***** * DoDrvr - Control shield driver ***** DoDrvr: clrh ;will not be cleared by sending message jsr getArg ;check for number argument jsr UpCase cmp #'0' ;compare to ASCII 0 beq DrvrOff cmp #'1' bne outOfRange bset 3,ptb ;turns on shield driver *** ldhx #MsgDrvrOn jmp OutMsgCr DrvrOff bclr 3,ptb ;turns off shield driver *** ldhx #MsgDrvrOff jmp OutMsgCr ***** * Command table - First byte of an entry specifies the length of * the ASCII command entry, next the full command is included as * upper case ASCII characters, finally there is a two byte * address where the command routine starts. * The routine that searches for the command can match with fewer * characters than the full command such as SC matches SCLK. * $FF in the command length field marks the end of the table. * Commands are called with a JSR and they end in an RTS. ***** CmdTbl: fcb 4 ;Show list of commands fcb 'HELP' fdb DoHELP fcb 1 ;Show list of commands fcb '?' fdb DoHELP fcb 1 fcb 'X' fdb DoEl2Hx fcb 6 fcb 'SELECT' fdb DoSelEl fcb 6 fcb 'DRIVER' fdb DoDrvr fcb $FF ;End of Command Table ***** * Messages ***** MsgPrompt: fcb 'EFLD Evaluation System v0.0 type HELP or ? for a list of commands' fcb $04 ;end-of-message mark MsgLong fcb 'Too long' fcb $07 ;ASCII for bell character fcb $0D,$0A ;skip a line fcb $04 MsgNotF fcb 'Command not found?' fcb $07 ;ASCII for bell character fcb $0D,$0A ;skip a line fcb $04 MsgErr1 fcb 'Command format error' fcb $07 ;ASCII bell fcb $04 MsgOutOfRange: fcb 'Selection is out of range.' fcb $04 MsgSelEl: ;fcb 'Electrode = ' fcb 'Electrode= ' fcb $04 MsgHelp fcb 'Type commands with no argument to get command help or show current settings.' fcb $0D,$0A fcb $0D,$0A fcb 'You only need to type the first letter(s) of a command like H or HE for HELP.' fcb $0D,$0A fcb $0A fcb 'Commands are NOT case sensitive (H = h).' fcb $0D,$0A fcb $0A fcb 'HELP or ? - Show this command summary' fcb $0D,$0A fcb $0A fcb 'Select electrode where n is a single hexadecimal digit (0-9 or a-f)' fcb 'or P for PWR_IN_MON, V for VDD_MON or X for external input to A/D.' fcb $0D,$0A fcb $0A fcb 'X = return A/D value of electrode level as a 2 digit hexadecimal number.' fcb $0D,$0A fcb $0A fcb 'DRIVER 0/1 Turn shield driver off(0) or on (1)' fcb $0D,$0A fcb $04 fcb $0A MsgSelPwr fcb 'PWR_IN_MON Selected.' fcb $0D,$0A fcb $04 MsgSelVdd fcb 'VDD_MON Selected.' fcb $0D,$0A fcb $04 MsgSelExtern fcb 'External A/D Input Selected.' fcb $0D,$0A fcb $04 MsgDrvrOn fcb 'Shield Driver is on.' fcb $0D,$0A fcb $04 MsgDrvrOff fcb 'Shield Driver is off.' fcb $0D,$0A fcb $04 ************************************************** * * dummyISR- Dummy Interrupt Service Routine. * Just does a return from interrupt. * ************************************************** dummyISR: rti ; return ************************************************** * * Vectors - Timer Interrupt Service Routine. * after a RESET. * ************************************************** ; org VectorStart ; dw dummyISR ; Time Base Vector ; dw dummyISR ; ADC Conversion Complete ; dw dummyISR ; Keyboard Vector ; dw dummyISR ; SCI Transmit Vector ; dw dummyISR ; SCI Receive Vector ; dw dummyISR ; SCI Error Vector ; dw dummyISR ; SPI Transmit Vector ; dw dummyISR ; SPI Receive Vector ; dw dummyISR ; TIM2 Overflow Vector ; dw dummyISR ; TIM2 Channel 1 Vector ; dw dummyISR ; TIM2 Channel 0 Vector ; dw dummyISR ; TIM1 Overflow Vector ; dw dummyISR ; TIM1 Channel 1 Vector ; dw dummyISR ; TIM1 Channel 0 Vector ; dw dummyISR ; PLL Vector ; dw dummyISR ; ~IRQ1 Vector ; dw dummyISR ; SWI Vector ; dw main ; Reset Vector org $fdfd jmp main